home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textfile.swg / 0051_Generalized Text handling.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  3.5 KB  |  139 lines
  1. {
  2.  
  3. The fastest way to read screen characters is to get them from video
  4. memory directly.  It's located at either Segment B800h (Color) or
  5. Segment B000h (Monochrome).  Each character is stored as two bytes, the
  6. Ascii code and an Attribute byte.  Here is some source if you are
  7. confused.
  8.  
  9. { ********************************************************** }
  10. { *********************** Text Unit ************************ }
  11. { ********************************************************** }
  12. { **************** Written by: Rick Haines ***************** }
  13. { **************************** 507 LakeShore Dr. *********** }
  14. { **************************** Eustis FL, 32726 ************ }
  15. { ********************************************************** }
  16. { ***************** Last Revised 11/12/94 ****************** }
  17. { ********************************************************** }
  18.  
  19. Unit Text;
  20.  
  21. { ************************* Attribute Byte ************************* }
  22. { ****************************************************************** }
  23. { ************** Bits 0-3 contain the foreground color ************* }
  24. { ************** Bits 4-6 contain the background color ************* }
  25. { ******************** Bit 7 is the blink bit ********************** }
  26. { ****************************************************************** }
  27.  
  28. Interface
  29.  
  30.  Const
  31.   Black  = 0;
  32.   Blue   = 1;
  33.   Green  = 2;
  34.   Cyan   = 3;
  35.   Red    = 4;
  36.   Violet = 5;
  37.   Orange = 6;
  38.   Gray   = 8;
  39.  
  40.   LightGray   = 7;
  41.   LightBlue   = 9;
  42.   LightGreen  = 10;
  43.   LightCyan   = 11;
  44.   LightRed    = 12;
  45.   LightViolet = 13;
  46.  
  47.   Yellow = 14;
  48.   White  = 15;
  49.  
  50.   Blink   = 128;
  51.  
  52.  Procedure WriteXY(X, Y : Byte; TextStr : String);
  53.  Procedure SetColor(Color : Byte);
  54.  Procedure SetBGColor(Color : Byte);
  55.  Procedure SaveScreen(Name : String);
  56.  Procedure LoadScreen(Name : String);
  57.  
  58. Implementation
  59.  Uses Crt;
  60.  
  61.  Type
  62.   RefreshBuffer = Array[0..24,0..79] Of Word;
  63.  
  64.  Var
  65.   TextMem   : ^RefreshBuffer;
  66.   TextColor : Byte;
  67.  
  68.  Procedure SetColor(Color : Byte);
  69.   Begin
  70.    TextColor := TextColor Or Color;
  71.   End;
  72.  
  73.  Procedure SetBGColor(Color : Byte);
  74.   Begin
  75.    If Color > 8 Then Exit;
  76.     Asm
  77.      Mov AL, [Color]
  78.      Mov BL, [TextColor]
  79.      RoR BL, 4
  80.      Or  BL, AL
  81.      RoL BL, 4
  82.      Mov [TextColor], BL
  83.     End;
  84.   End;
  85.  
  86.  Function TextChar(Ch : Char) : Word; Assembler;
  87.   Asm
  88.    Mov AH, TextColor
  89.    Mov AL, Ch
  90.   End;
  91.  
  92.  Procedure WriteXY(X, Y : Byte; TextStr : String);
  93.   Var
  94.    I : Byte;
  95.   Begin
  96.    For I := 1 To Length(TextStr) Do TextMem^[Y,X+I-1] := TextChar(TextStr[I]);
  97.   End;
  98.  
  99.  Procedure SaveScreen(Name : String);
  100.   Var
  101.    FileN : File;
  102.   Begin
  103.    Assign(FileN, Name + '.Scr');
  104.    Rewrite(FileN, 2000);
  105.    BlockWrite(FileN, TextMem^, 2);
  106.    Close(FileN);
  107.   End;
  108.  
  109.  Procedure LoadScreen(Name : String);
  110.   Var
  111.    FileN : File;
  112.   Begin
  113.    Assign(FileN, Name + '.Scr');
  114.    Reset(FileN, 2000);
  115.    BlockRead(FileN, TextMem^, 2);
  116.    Close(FileN);
  117.   End;
  118.  
  119. Begin
  120.  If LastMode = Mono Then TextMem := Ptr($B000,$0000) Else TextMem := Ptr($B800,
  121.  SetBGColor(Black);
  122.  SetColor(LightGray);
  123. End.
  124.  
  125.  
  126.                                                 Good Luck,
  127.  
  128.                                                 -Rick
  129.  
  130.  
  131.  * OLX 2.1 TD * With Pascal Do Write(Program);
  132.  
  133.  
  134. --- QScan v1.12b / 01-0240
  135.  * Origin: Craig's DATA Exchange! BBS 1:3669/50 904-483-2463 (1:3669/50)
  136. SEEN-BY: 363/3 34 118 157 603 1571 396/1 3615/50 51 3633/132
  137. SEEN-BY: 3669/18 50 54
  138. PATH: 3669/50 54 363/157 3615/50
  139.